Predicting heartdisease
Lukas Diex, LLuís Quintana, Caroline Nakowitsch
2024-02-29
Introduction
In recent years, health economics has emerged as a dynamic field of research, gaining increasing attention due to its critical role in shaping healthcare policies and improving the overall well-being of populations. This research project aims to investigate the factors influencing heart disease, using US-American health data from the Behavioral Risk Factor Surveillance System (BRFSS) Survey 2022, provided by the Centers for Disease Control and Prevention (CDC). Specifically, we intend to employ a set of machine learning algorithms to analyze the BRFSS dataset.
While there is extensive research on this topic, little work has been carried out with machine learning techniques. Machine learning models with high predictive power can help determine the best course of treatment for a patient with a heart failure diagnosis. This approach assists doctors in making early diagnoses that reduce costs (G C et al., 2019). Previous research has achieved a 90.16% accuracy with a logistic regression and 90% with AdaBoost (Samineni, 2023) or 87% using k-Nearest Neighbors Classifier (Kamboj, 2018). Already existing literature agrees on elevated cholesterol levels, high blood pressure, diabetes, obesity, smoking and the lack of physical activity as main causes of cardiovascular heart diseases (CHD). However, the CDC’s dataset does not cover all of those causes as variables - cholesterol and blood pressure are missing. Therefore, this seminar paper deals with two specific questions. By using the CDC’s dataset we first verify the main causes already investigated by the literature using both random forest and XG-boost models. Secondly, we show what other factors can be identified by applying these methods to the CDC’s dataset. As this dataset also features information about COVID-19-infection rate we can also contribute to currently relevant topics within this field of research.
We intend to delevop a model that predicts, which individuals have higher chances of suffering from a heart disease and model the main causes of having a heart disease with machine learning techniques such as the random forest or XGBoost algorithms. The study will explore key determinants of heart disease, such as demographic factors, lifestyle choices, and pre-existing health conditions. In the context of medical data analysis, where the consequences of false negatives (missed diagnoses) can be severe, sensitivity should be prioritized over specificity. Sensitivity measures the ability of a model to correctly identify positive cases, in our case the presence of heart disease. A model with high sensitivity, even at the expense of specificity, minimizes the risk of false negatives and maximizes the detection of true positives. Therefore, in our project, we intend to build a conservative model with high sensitivity, as we rather be too cautious than to overlook a critical condition.
Data, sources and exploration
The data used within this work is part of the 2022 version of the Behavioral Risk Factor Surveillance System from the Centre for Disease Control and Prevention in the US. During this year, data was collected in 50 states of the US as well as the District of Columbia, Guam, the Commonwealth of Puerto Rico, and the US Virgin Islands, using land-line and cellular phone based interviews. Therefore, within this document the term “state” refers to all spatial units participating in the BRFSS. In order to circumvent sampling biases, the CDC applied complex sampling weights to the dataset. We would like to acknowledge that due to constraints posed by the size of the original dataset, we encountered challenges in transforming it for our analysis. As a solution, we opted to utilize a reduced dataset sourced from Kaggle, which contains the most prominent health variables essential for our research objectives. While the original dataset features about 445.000 observations of more than 300 independent variables, our version is already tailored for the specific use of analysing heart disease risk and was published on Kaggle. Therefore, our version only contains 246.022 observations of 40 variables. Moreover, a thorough data cleaning process is already applied to the data. Therefore, we do not have to deal with missing data any longer.
Further information about the data can be found here: https://www.cdc.gov/brfss/annual_data/2022/pdf/Overview_2022-508.pdf
The dataset we use consists of six numerical variables and 34 cateogrical variables. The tables below present the main summary statistics of the dataset.
## State Sex GeneralHealth PhysicalHealthDays
## Length:246022 Length:246022 Length:246022 Min. : 0.000
## Class :character Class :character Class :character 1st Qu.: 0.000
## Mode :character Mode :character Mode :character Median : 0.000
## Mean : 4.119
## 3rd Qu.: 3.000
## Max. :30.000
## MentalHealthDays LastCheckupTime PhysicalActivities SleepHours
## Min. : 0.000 Length:246022 Length:246022 Min. : 1.000
## 1st Qu.: 0.000 Class :character Class :character 1st Qu.: 6.000
## Median : 0.000 Mode :character Mode :character Median : 7.000
## Mean : 4.167 Mean : 7.021
## 3rd Qu.: 4.000 3rd Qu.: 8.000
## Max. :30.000 Max. :24.000
## RemovedTeeth HadHeartAttack HadAngina HadStroke
## Length:246022 Length:246022 Length:246022 Length:246022
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## HadAsthma HadSkinCancer HadCOPD HadDepressiveDisorder
## Length:246022 Length:246022 Length:246022 Length:246022
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## HadKidneyDisease HadArthritis HadDiabetes DeafOrHardOfHearing
## Length:246022 Length:246022 Length:246022 Length:246022
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## BlindOrVisionDifficulty DifficultyConcentrating DifficultyWalking
## Length:246022 Length:246022 Length:246022
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
## DifficultyDressingBathing DifficultyErrands SmokerStatus
## Length:246022 Length:246022 Length:246022
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
## ECigaretteUsage ChestScan RaceEthnicityCategory AgeCategory
## Length:246022 Length:246022 Length:246022 Length:246022
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## HeightInMeters WeightInKilograms BMI AlcoholDrinkers
## Min. :0.910 Min. : 28.12 Min. :12.02 Length:246022
## 1st Qu.:1.630 1st Qu.: 68.04 1st Qu.:24.27 Class :character
## Median :1.700 Median : 81.65 Median :27.46 Mode :character
## Mean :1.705 Mean : 83.62 Mean :28.67
## 3rd Qu.:1.780 3rd Qu.: 95.25 3rd Qu.:31.89
## Max. :2.410 Max. :292.57 Max. :97.65
## HIVTesting FluVaxLast12 PneumoVaxEver TetanusLast10Tdap
## Length:246022 Length:246022 Length:246022 Length:246022
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## HighRiskLastYear CovidPos
## Length:246022 Length:246022
## Class :character Class :character
## Mode :character Mode :character
##
##
## ## PhysicalHealthDays MentalHealthDays SleepHours HeightInMeters
## Min. : 0.000 Min. : 0.000 Min. : 1.000 Min. :0.910
## 1st Qu.: 0.000 1st Qu.: 0.000 1st Qu.: 6.000 1st Qu.:1.630
## Median : 0.000 Median : 0.000 Median : 7.000 Median :1.700
## Mean : 4.119 Mean : 4.167 Mean : 7.021 Mean :1.705
## 3rd Qu.: 3.000 3rd Qu.: 4.000 3rd Qu.: 8.000 3rd Qu.:1.780
## Max. :30.000 Max. :30.000 Max. :24.000 Max. :2.410
## WeightInKilograms BMI
## Min. : 28.12 Min. :12.02
## 1st Qu.: 68.04 1st Qu.:24.27
## Median : 81.65 Median :27.46
## Mean : 83.62 Mean :28.67
## 3rd Qu.: 95.25 3rd Qu.:31.89
## Max. :292.57 Max. :97.65| Variable | Min | Q1 | Median | Mean | Q3 | Max |
|---|---|---|---|---|---|---|
| PhysicalHealthDays | 0.00 | 0.00 | 0.00 | 4.12 | 3.00 | 30.00 |
| MentalHealthDays | 0.00 | 0.00 | 0.00 | 4.17 | 4.00 | 30.00 |
| SleepHours | 1.00 | 6.00 | 7.00 | 7.02 | 8.00 | 24.00 |
| HeightInMeters | 0.91 | 1.63 | 1.70 | 1.71 | 1.78 | 2.41 |
| WeightInKilograms | 28.12 | 68.04 | 81.65 | 83.62 | 95.25 | 292.57 |
| BMI | 12.02 | 24.27 | 27.46 | 28.67 | 31.89 | 97.65 |
## State Sex GeneralHealth PhysicalHealthDays
## Length:246022 Length:246022 Length:246022 Min. : 0.000
## Class :character Class :character Class :character 1st Qu.: 0.000
## Mode :character Mode :character Mode :character Median : 0.000
## Mean : 4.119
## 3rd Qu.: 3.000
## Max. :30.000
## MentalHealthDays LastCheckupTime PhysicalActivities SleepHours
## Min. : 0.000 Length:246022 Length:246022 Min. : 1.000
## 1st Qu.: 0.000 Class :character Class :character 1st Qu.: 6.000
## Median : 0.000 Mode :character Mode :character Median : 7.000
## Mean : 4.167 Mean : 7.021
## 3rd Qu.: 4.000 3rd Qu.: 8.000
## Max. :30.000 Max. :24.000
## RemovedTeeth HadHeartAttack HadAngina HadStroke
## Length:246022 Length:246022 Length:246022 Length:246022
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## HadAsthma HadSkinCancer HadCOPD HadDepressiveDisorder
## Length:246022 Length:246022 Length:246022 Length:246022
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## HadKidneyDisease HadArthritis HadDiabetes DeafOrHardOfHearing
## Length:246022 Length:246022 Length:246022 Length:246022
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## BlindOrVisionDifficulty DifficultyConcentrating DifficultyWalking
## Length:246022 Length:246022 Length:246022
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
## DifficultyDressingBathing DifficultyErrands SmokerStatus
## Length:246022 Length:246022 Length:246022
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
## ECigaretteUsage ChestScan RaceEthnicityCategory AgeCategory
## Length:246022 Length:246022 Length:246022 Length:246022
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## HeightInMeters WeightInKilograms BMI AlcoholDrinkers
## Min. :0.910 Min. : 28.12 Min. :12.02 Length:246022
## 1st Qu.:1.630 1st Qu.: 68.04 1st Qu.:24.27 Class :character
## Median :1.700 Median : 81.65 Median :27.46 Mode :character
## Mean :1.705 Mean : 83.62 Mean :28.67
## 3rd Qu.:1.780 3rd Qu.: 95.25 3rd Qu.:31.89
## Max. :2.410 Max. :292.57 Max. :97.65
## HIVTesting FluVaxLast12 PneumoVaxEver TetanusLast10Tdap
## Length:246022 Length:246022 Length:246022 Length:246022
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## HighRiskLastYear CovidPos
## Length:246022 Length:246022
## Class :character Class :character
## Mode :character Mode :character
##
##
## | State | Sex | GeneralHealth | LastCheckupTime | PhysicalActivities | RemovedTeeth | HadHeartAttack | HadAngina | HadStroke | HadAsthma | HadSkinCancer | HadCOPD | HadDepressiveDisorder | HadKidneyDisease | HadArthritis | HadDiabetes | DeafOrHardOfHearing | BlindOrVisionDifficulty | DifficultyConcentrating | DifficultyWalking | DifficultyDressingBathing | DifficultyErrands | SmokerStatus | ECigaretteUsage | ChestScan | RaceEthnicityCategory | AgeCategory | AlcoholDrinkers | HIVTesting | FluVaxLast12 | PneumoVaxEver | TetanusLast10Tdap | HighRiskLastYear | CovidPos | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Washington: 15000 | Female:127811 | Excellent:41525 | 5 or more years ago : 10898 | No : 54704 | 1 to 5 : 74702 | No :232587 | No :231069 | No :235910 | No :209493 | No :225001 | No :227028 | No :195402 | No :234738 | No :161139 | No :204834 | No :224990 | No :233796 | No :219802 | No :209952 | No :237682 | No :229638 | Current smoker - now smokes every day: 21659 | Never used e-cigarettes in my entire life:190128 | No :141822 | Black only, Non-Hispanic : 19330 | Age 65 to 69: 28557 | No :110715 | No :161520 | No :114826 | No :146130 | No, did not receive any tetanus shot in the past 10 years:81747 | No :235446 | No :167306 | |
| Maryland : 9165 | Male :118211 | Fair :30659 | Within past 2 years (1 year but less than 2 years ago) : 23227 | Yes:191318 | 6 or more, but not all: 25950 | Yes: 13435 | Yes: 14953 | Yes: 10112 | Yes: 36529 | Yes: 21021 | Yes: 18994 | Yes: 50620 | Yes: 11284 | Yes: 84883 | No, pre-diabetes or borderline diabetes: 5392 | Yes: 21032 | Yes: 12226 | Yes: 26220 | Yes: 36070 | Yes: 8340 | Yes: 16384 | Current smoker - now smokes some days: 8099 | Not at all (right now) : 43281 | Yes:104200 | Hispanic : 22570 | Age 60 to 64: 26720 | Yes:135307 | Yes: 84502 | Yes:131196 | Yes: 99892 | Yes, received Tdap :70286 | Yes: 10576 | Tested positive using home test without a health professional: 8392 | |
| Minnesota : 9161 | NA | Good :77409 | Within past 5 years (2 years but less than 5 years ago): 13744 | NA | All : 13778 | NA | NA | NA | NA | NA | NA | NA | NA | NA | Yes : 33813 | NA | NA | NA | NA | NA | NA | Former smoker : 68527 | Use them every day : 5955 | NA | Multiracial, Non-Hispanic : 5581 | Age 70 to 74: 25739 | NA | NA | NA | NA | Yes, received tetanus shot but not sure what type :74119 | NA | Yes : 70324 | |
| Ohio : 8995 | NA | Poor : 9430 | Within past year (anytime less than 12 months ago) :198153 | NA | None of them :131592 | NA | NA | NA | NA | NA | NA | NA | NA | NA | Yes, but only during pregnancy (female): 1983 | NA | NA | NA | NA | NA | NA | Never smoked :147737 | Use them some days : 6658 | NA | Other race only, Non-Hispanic: 12205 | Age 55 to 59: 22224 | NA | NA | NA | NA | Yes, received tetanus shot, but not Tdap :19870 | NA | NA | |
| New York : 8923 | NA | Very good:86999 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | White only, Non-Hispanic :186336 | Age 50 to 54: 19913 | NA | NA | NA | NA | NA | NA | NA | |
| Texas : 7408 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | Age 75 to 79: 18136 | NA | NA | NA | NA | NA | NA | NA | |
| (Other) :187370 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | (Other) :104733 | NA | NA | NA | NA | NA | NA | NA |
Data visualisation
Dependent variable
Luckily, not every person is having a heart disease over the course of their lifetime. It is even more unlikely to get a balanced sample from conducting survey interviews. Therefore, our first interest is in analyzing the dependent variable. As the piechart below shows, only 13.435 individuals, or 5% of observations did or still do suffer from heart disease, leading to an unbalanced sample distribution in the dependent variable. We will adress this problem by applin methods such as X, Y and Z.
## [1] 13435
Independent variables
Regarding numerical independent variables the density curves below indicate that having a higher BMI, body weight and the amount of days devoted to physical and mental health reduce the chances of having a heart attack. However, the interpretation of sleeping hours and height of the person seems less clear.
## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: The `size` argument of `element_line()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
According to the literature (CDC) the main factors of heart disease are:
high blood pressure, high cholesterol, diabetes, smoking, obesity,
unhealthy diet, physical inactivity. While physical health days do not
offer a clear picture we still have look on the other causes identified
graphically.
## Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
For smokers our sample shows that every day smokers have the highest
risk of getting a heart disease. However, this does not confirm it’s
overall impact on actually getting one. This also holds for the other
variables. This section only features visualizations of our sample
data.
We can observe how being a smoker, having diabetes and not practicing physical activities, increase the chances of having a heart attack.
## $corr
## HadHeartAttack PhysicalHealthDays HadAngina HadStroke
## HadHeartAttack 1.0000000 0.13341951 0.4459033 0.17713680
## PhysicalHealthDays 0.1334195 1.00000000 0.1491299 0.12873138
## HadAngina 0.4459033 0.14912994 1.0000000 0.15188307
## HadStroke 0.1771368 0.12873138 0.1518831 1.00000000
## HadCOPD 0.1332226 0.21715793 0.1539604 0.10672292
## HadKidneyDisease 0.1093552 0.14002663 0.1446881 0.09123687
## HadArthritis 0.1177727 0.23337828 0.1458647 0.10018598
## HadDiabetes 0.1350990 0.15013041 0.1433652 0.10290061
## DifficultyWalking 0.1598781 0.43151378 0.1721679 0.16834910
## ChestScan 0.1677603 0.18318046 0.1845024 0.13575099
## AgeCategory 0.1721717 0.08987905 0.1988970 0.13236099
## PneumoVaxEver 0.1199553 0.10121895 0.1577480 0.08906288
## HadCOPD HadKidneyDisease HadArthritis HadDiabetes
## HadHeartAttack 0.13322261 0.10935517 0.1177727 0.13509903
## PhysicalHealthDays 0.21715793 0.14002663 0.2333783 0.15013041
## HadAngina 0.15396042 0.14468808 0.1458647 0.14336523
## HadStroke 0.10672292 0.09123687 0.1001860 0.10290061
## HadCOPD 1.00000000 0.08872459 0.1748641 0.09876945
## HadKidneyDisease 0.08872459 1.00000000 0.1290278 0.15498890
## HadArthritis 0.17486414 0.12902778 1.0000000 0.14855986
## HadDiabetes 0.09876945 0.15498890 0.1485599 1.00000000
## DifficultyWalking 0.23899153 0.15818045 0.3185287 0.20260316
## ChestScan 0.19826850 0.12539201 0.2135318 0.13406515
## AgeCategory 0.14633554 0.13636156 0.3789190 0.18341359
## PneumoVaxEver 0.16226789 0.12963099 0.2634148 0.17160136
## DifficultyWalking ChestScan AgeCategory PneumoVaxEver
## HadHeartAttack 0.1598781 0.1677603 0.17217169 0.11995535
## PhysicalHealthDays 0.4315138 0.1831805 0.08987905 0.10121895
## HadAngina 0.1721679 0.1845024 0.19889698 0.15774797
## HadStroke 0.1683491 0.1357510 0.13236099 0.08906288
## HadCOPD 0.2389915 0.1982685 0.14633554 0.16226789
## HadKidneyDisease 0.1581804 0.1253920 0.13636156 0.12963099
## HadArthritis 0.3185287 0.2135318 0.37891896 0.26341485
## HadDiabetes 0.2026032 0.1340652 0.18341359 0.17160136
## DifficultyWalking 1.0000000 0.2075584 0.23188481 0.16930781
## ChestScan 0.2075584 1.0000000 0.26234721 0.21762199
## AgeCategory 0.2318848 0.2623472 1.00000000 0.42431762
## PneumoVaxEver 0.1693078 0.2176220 0.42431762 1.00000000
##
## $corrPos
## xName yName x y corr
## 1 HadHeartAttack HadHeartAttack 1 12 1.00000000
## 2 PhysicalHealthDays HadHeartAttack 2 12 0.13341951
## 3 PhysicalHealthDays PhysicalHealthDays 2 11 1.00000000
## 4 HadAngina HadHeartAttack 3 12 0.44590331
## 5 HadAngina PhysicalHealthDays 3 11 0.14912994
## 6 HadAngina HadAngina 3 10 1.00000000
## 7 HadStroke HadHeartAttack 4 12 0.17713680
## 8 HadStroke PhysicalHealthDays 4 11 0.12873138
## 9 HadStroke HadAngina 4 10 0.15188307
## 10 HadStroke HadStroke 4 9 1.00000000
## 11 HadCOPD HadHeartAttack 5 12 0.13322261
## 12 HadCOPD PhysicalHealthDays 5 11 0.21715793
## 13 HadCOPD HadAngina 5 10 0.15396042
## 14 HadCOPD HadStroke 5 9 0.10672292
## 15 HadCOPD HadCOPD 5 8 1.00000000
## 16 HadKidneyDisease HadHeartAttack 6 12 0.10935517
## 17 HadKidneyDisease PhysicalHealthDays 6 11 0.14002663
## 18 HadKidneyDisease HadAngina 6 10 0.14468808
## 19 HadKidneyDisease HadStroke 6 9 0.09123687
## 20 HadKidneyDisease HadCOPD 6 8 0.08872459
## 21 HadKidneyDisease HadKidneyDisease 6 7 1.00000000
## 22 HadArthritis HadHeartAttack 7 12 0.11777270
## 23 HadArthritis PhysicalHealthDays 7 11 0.23337828
## 24 HadArthritis HadAngina 7 10 0.14586473
## 25 HadArthritis HadStroke 7 9 0.10018598
## 26 HadArthritis HadCOPD 7 8 0.17486414
## 27 HadArthritis HadKidneyDisease 7 7 0.12902778
## 28 HadArthritis HadArthritis 7 6 1.00000000
## 29 HadDiabetes HadHeartAttack 8 12 0.13509903
## 30 HadDiabetes PhysicalHealthDays 8 11 0.15013041
## 31 HadDiabetes HadAngina 8 10 0.14336523
## 32 HadDiabetes HadStroke 8 9 0.10290061
## 33 HadDiabetes HadCOPD 8 8 0.09876945
## 34 HadDiabetes HadKidneyDisease 8 7 0.15498890
## 35 HadDiabetes HadArthritis 8 6 0.14855986
## 36 HadDiabetes HadDiabetes 8 5 1.00000000
## 37 DifficultyWalking HadHeartAttack 9 12 0.15987808
## 38 DifficultyWalking PhysicalHealthDays 9 11 0.43151378
## 39 DifficultyWalking HadAngina 9 10 0.17216789
## 40 DifficultyWalking HadStroke 9 9 0.16834910
## 41 DifficultyWalking HadCOPD 9 8 0.23899153
## 42 DifficultyWalking HadKidneyDisease 9 7 0.15818045
## 43 DifficultyWalking HadArthritis 9 6 0.31852872
## 44 DifficultyWalking HadDiabetes 9 5 0.20260316
## 45 DifficultyWalking DifficultyWalking 9 4 1.00000000
## 46 ChestScan HadHeartAttack 10 12 0.16776031
## 47 ChestScan PhysicalHealthDays 10 11 0.18318046
## 48 ChestScan HadAngina 10 10 0.18450244
## 49 ChestScan HadStroke 10 9 0.13575099
## 50 ChestScan HadCOPD 10 8 0.19826850
## 51 ChestScan HadKidneyDisease 10 7 0.12539201
## 52 ChestScan HadArthritis 10 6 0.21353177
## 53 ChestScan HadDiabetes 10 5 0.13406515
## 54 ChestScan DifficultyWalking 10 4 0.20755838
## 55 ChestScan ChestScan 10 3 1.00000000
## 56 AgeCategory HadHeartAttack 11 12 0.17217169
## 57 AgeCategory PhysicalHealthDays 11 11 0.08987905
## 58 AgeCategory HadAngina 11 10 0.19889698
## 59 AgeCategory HadStroke 11 9 0.13236099
## 60 AgeCategory HadCOPD 11 8 0.14633554
## 61 AgeCategory HadKidneyDisease 11 7 0.13636156
## 62 AgeCategory HadArthritis 11 6 0.37891896
## 63 AgeCategory HadDiabetes 11 5 0.18341359
## 64 AgeCategory DifficultyWalking 11 4 0.23188481
## 65 AgeCategory ChestScan 11 3 0.26234721
## 66 AgeCategory AgeCategory 11 2 1.00000000
## 67 PneumoVaxEver HadHeartAttack 12 12 0.11995535
## 68 PneumoVaxEver PhysicalHealthDays 12 11 0.10121895
## 69 PneumoVaxEver HadAngina 12 10 0.15774797
## 70 PneumoVaxEver HadStroke 12 9 0.08906288
## 71 PneumoVaxEver HadCOPD 12 8 0.16226789
## 72 PneumoVaxEver HadKidneyDisease 12 7 0.12963099
## 73 PneumoVaxEver HadArthritis 12 6 0.26341485
## 74 PneumoVaxEver HadDiabetes 12 5 0.17160136
## 75 PneumoVaxEver DifficultyWalking 12 4 0.16930781
## 76 PneumoVaxEver ChestScan 12 3 0.21762199
## 77 PneumoVaxEver AgeCategory 12 2 0.42431762
## 78 PneumoVaxEver PneumoVaxEver 12 1 1.00000000
##
## $arg
## $arg$type
## [1] "upper"## png
## 2For the correlation matrix we select variables that we expect to have the biggest correlation with our dependent variable. We can see only positive correlations. Heart disease is only considerably correlated with “Had Angina”, which seems plausible as it in itself is a heart disease.
Methodology
In the following section, we will construct, compare, and select predictive machine learning models. We select models by evaluating their performance and determining the impact of different variables on the final model’s efficacy for prediction.
Whether a survey respondent has had a heart disease - the dependent variable - can either be of outcome “yes” or “no”. Therefore, this analysis concerns a classification problem. Due to the complex dynamics that might lead to a heart disease, we already know that the two classes are not uniformly distributed. While for example smoking increases the risk of suffering from a heart disease, this does not have to be the case in general. Therefore, it is expected that the class of people that actually suffered from a heart disease is underrepresented, leading to class imbalance. The presence of such class imbalances implies serious consequences such as estimates becoming biased in favor of predicting the majority class. Furthermore, due to the class imbalance, evaluation metrics such as accuracy might be misleading. Overall, the model might focus on learning patterns from the majority class and may not generalize well to the minority class.In order to circumvent these issues resampling techniques are needed. More precisely, we will begin with under sampling as a method to increase class balance. As an alternative approach, we apply higher weights to the minority class to account for the class imbalance and thus increase the robustness of our predictions.
As already mentioned in this proposal’s introduction, in order to solve this classification problem, we will rely on classification trees based on majority voting as a method of random forests. Moreover, in order to decrease the variance of predictions, we will also address tree nodes such that we achieve a process of decorrelating the individual trees by forcing each split to consider only a random subset of the predictors. This process is especially useful as it prevents trees from always choosing the strongest predictor for the top split. An evaluation of the models will then be carried out by appropriate metrics such as precision, recall and the area under the ROC-curve.
Following the evaluation of our models, hyperparameter tuning processes will be needed in order to find the optimal number of trees, tree depth and subset of predictors considered at each split. However, as we don’t have as of now, we cannot give a detailed explanation of these processes.
Analysis
In the following section, we will construct, compare, and select predictive models, evaluating their performance and determining the impact of different variables on the final model’s efficacy for prediction.
data set up
basic model (caret)
The first model we tried out is from the caret package, using the method “rpart”. This way, we are able to produce the visualization of the model’s decision tree in the end. We incldued a control parameter (control_rf), wich specifies repeated cross-validation with 10 folds and 10 repetitions. The tuning grid (tuning_grid) definies different values for the model complexity (cp) explored in the training of the model.
Firstly, a control object control_rf is defined using trainControl(), specifying the method for cross-validation (repeatedcv), the number of folds (number = 10), the number of repetitions (repeats = 10), enabling class probabilities (classProbs = TRUE), specifying the summary function (twoClassSummary), and enabling the saving of predictions (savePredictions = TRUE).
# defining the tuning grid
tuning_grid <- expand.grid(cp = c(0.001, 0.005, 0.01, 0.05))
#using caret to build trees
rf_caret <- train(
target ~ .,
data = train_df,
method = "rpart",
trControl = control_rf,
tuneGrid = tuning_grid,
metric = "ROC")
rf_caret## CART
##
## 196817 samples
## 39 predictor
## 2 classes: 'No', 'Yes'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 10 times)
## Summary of sample sizes: 177134, 177135, 177136, 177135, 177136, 177134, ...
## Resampling results across tuning parameters:
##
## cp ROC Sens Spec
## 0.001 0.7370908 0.9916060 0.20291608
## 0.005 0.7368555 0.9935965 0.15805861
## 0.010 0.5567126 0.9990090 0.02376821
## 0.050 0.5000000 1.0000000 0.00000000
##
## ROC was used to select the optimal model using the largest value.
## The final value used for the model was cp = 0.001.#observing the tree
tree <- rf_caret$finalModel
rpart.plot(tree, box.palette="RdBu", nn=FALSE, type=2)
The results from our first try of training the model were quite
unsatisfactory. However, from the tree we can observe first variable
importance, with the variable “HadAngina” being the most important one,
which is plausible since Angina is a heart disease. This is followed by
having had a chest scan, removed teeth and had a stroke.
Regarding sample imbalance the data used was not taken care of. In order to account for this, we down sample the data. This means that the majority class is randomly under sampled to balance the class distribution. The R-function “downSample” randomly selects a subset of observations from the majority class to match the number of observations in the minority class. In our case, a subset from “No” is sampled to obtain the number of observations in “Yes”. The results show that afterwards the number of observations for each outcome in the target variable is equal in the sample.
# Performing downsampling
downsampled_data <- downSample(
x = train_df[, -40], # Exclude the target variable
y = train_df$target,
yname = "target")
## looking, wether the sample is now balanced
# creating a data frame for plotting
plot_data_down <- data.frame(
Class = levels(downsampled_data$target),
Count = table(downsampled_data$target)
)
# Create a bar chart
ggplot(plot_data_down, aes(x = Class, y = Count.Freq, fill = Class)) +
geom_bar(stat = "identity", color = "black", show.legend = FALSE) +
labs(title = "Balanced sample distribution",
x = "Outcomes in target variable") +
theme_minimal()
# caret model with adjusted data
rf_caret_down <- train(
target ~ .,
data = downsampled_data,
method = "rpart",
trControl = control_rf,
tuneGrid = tuning_grid,
metric = "ROC")
rf_caret_down## CART
##
## 21464 samples
## 39 predictor
## 2 classes: 'No', 'Yes'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 10 times)
## Summary of sample sizes: 19318, 19318, 19318, 19318, 19318, 19318, ...
## Resampling results across tuning parameters:
##
## cp ROC Sens Spec
## 0.001 0.8587320 0.8266482 0.7543974
## 0.005 0.8377499 0.8326956 0.7383904
## 0.010 0.8369769 0.8426463 0.7266117
## 0.050 0.7355567 0.9653370 0.5057764
##
## ROC was used to select the optimal model using the largest value.
## The final value used for the model was cp = 0.001.#results
basic_balanced_model <- rf_caret_down$finalModel
summary(basic_balanced_model)## Call:
## (function (formula, data, weights, subset, na.action = na.rpart,
## method, model = FALSE, x = FALSE, y = TRUE, parms, control,
## cost, ...)
## {
## Call <- match.call()
## if (is.data.frame(model)) {
## m <- model
## model <- FALSE
## }
## else {
## indx <- match(c("formula", "data", "weights", "subset"),
## names(Call), nomatch = 0)
## if (indx[1] == 0)
## stop("a 'formula' argument is required")
## temp <- Call[c(1, indx)]
## temp$na.action <- na.action
## temp[[1]] <- quote(stats::model.frame)
## m <- eval.parent(temp)
## }
## Terms <- attr(m, "terms")
## if (any(attr(Terms, "order") > 1))
## stop("Trees cannot handle interaction terms")
## Y <- model.response(m)
## wt <- model.weights(m)
## if (any(wt < 0))
## stop("negative weights not allowed")
## if (!length(wt))
## wt <- rep(1, nrow(m))
## offset <- model.offset(m)
## X <- rpart.matrix(m)
## nobs <- nrow(X)
## nvar <- ncol(X)
## if (missing(method)) {
## method <- if (is.factor(Y) || is.character(Y))
## "class"
## else if (inherits(Y, "Surv"))
## "exp"
## else if (is.matrix(Y))
## "poisson"
## else "anova"
## }
## if (is.list(method)) {
## mlist <- method
## method <- "user"
## init <- if (missing(parms))
## mlist$init(Y, offset, wt = wt)
## else mlist$init(Y, offset, parms, wt)
## keep <- rpartcallback(mlist, nobs, init)
## method.int <- 4
## parms <- init$parms
## }
## else {
## method.int <- pmatch(method, c("anova", "poisson", "class",
## "exp"))
## if (is.na(method.int))
## stop("Invalid method")
## method <- c("anova", "poisson", "class", "exp")[method.int]
## if (method.int == 4)
## method.int <- 2
## init <- if (missing(parms))
## get(paste("rpart", method, sep = "."), envir = environment())(Y,
## offset, , wt)
## else get(paste("rpart", method, sep = "."), envir = environment())(Y,
## offset, parms, wt)
## ns <- asNamespace("rpart")
## if (!is.null(init$print))
## environment(init$print) <- ns
## if (!is.null(init$summary))
## environment(init$summary) <- ns
## if (!is.null(init$text))
## environment(init$text) <- ns
## }
## Y <- init$y
## xlevels <- .getXlevels(Terms, m)
## cats <- rep(0, ncol(X))
## if (!is.null(xlevels)) {
## indx <- match(names(xlevels), colnames(X), nomatch = 0)
## cats[indx] <- (unlist(lapply(xlevels, length)))[indx >
## 0]
## }
## extraArgs <- list(...)
## if (length(extraArgs)) {
## controlargs <- names(formals(rpart.control))
## indx <- match(names(extraArgs), controlargs, nomatch = 0)
## if (any(indx == 0))
## stop(gettextf("Argument %s not matched", names(extraArgs)[indx ==
## 0]), domain = NA)
## }
## controls <- rpart.control(...)
## if (!missing(control))
## controls[names(control)] <- control
## xval <- controls$xval
## if (is.null(xval) || (length(xval) == 1 && xval == 0) ||
## method == "user") {
## xgroups <- 0
## xval <- 0
## }
## else if (length(xval) == 1) {
## xgroups <- sample(rep(1:xval, length.out = nobs), nobs,
## replace = FALSE)
## }
## else if (length(xval) == nobs) {
## xgroups <- xval
## xval <- length(unique(xgroups))
## }
## else {
## if (!is.null(attr(m, "na.action"))) {
## temp <- as.integer(attr(m, "na.action"))
## xval <- xval[-temp]
## if (length(xval) == nobs) {
## xgroups <- xval
## xval <- length(unique(xgroups))
## }
## else stop("Wrong length for 'xval'")
## }
## else stop("Wrong length for 'xval'")
## }
## if (missing(cost))
## cost <- rep(1, nvar)
## else {
## if (length(cost) != nvar)
## stop("Cost vector is the wrong length")
## if (any(cost <= 0))
## stop("Cost vector must be positive")
## }
## tfun <- function(x) if (is.matrix(x))
## rep(is.ordered(x), ncol(x))
## else is.ordered(x)
## labs <- sub("^`(.*)`$", "\\1", attr(Terms, "term.labels"))
## isord <- unlist(lapply(m[labs], tfun))
## storage.mode(X) <- "double"
## storage.mode(wt) <- "double"
## temp <- as.double(unlist(init$parms))
## if (!length(temp))
## temp <- 0
## rpfit <- .Call(C_rpart, ncat = as.integer(cats * !isord),
## method = as.integer(method.int), as.double(unlist(controls)),
## temp, as.integer(xval), as.integer(xgroups), as.double(t(init$y)),
## X, wt, as.integer(init$numy), as.double(cost))
## nsplit <- nrow(rpfit$isplit)
## ncat <- if (!is.null(rpfit$csplit))
## nrow(rpfit$csplit)
## else 0
## if (nsplit == 0)
## xval <- 0
## numcp <- ncol(rpfit$cptable)
## temp <- if (nrow(rpfit$cptable) == 3)
## c("CP", "nsplit", "rel error")
## else c("CP", "nsplit", "rel error", "xerror", "xstd")
## dimnames(rpfit$cptable) <- list(temp, 1:numcp)
## tname <- c("<leaf>", colnames(X))
## splits <- matrix(c(rpfit$isplit[, 2:3], rpfit$dsplit), ncol = 5,
## dimnames = list(tname[rpfit$isplit[, 1] + 1], c("count",
## "ncat", "improve", "index", "adj")))
## index <- rpfit$inode[, 2]
## nadd <- sum(isord[rpfit$isplit[, 1]])
## if (nadd > 0) {
## newc <- matrix(0, nadd, max(cats))
## cvar <- rpfit$isplit[, 1]
## indx <- isord[cvar]
## cdir <- splits[indx, 2]
## ccut <- floor(splits[indx, 4])
## splits[indx, 2] <- cats[cvar[indx]]
## splits[indx, 4] <- ncat + 1:nadd
## for (i in 1:nadd) {
## newc[i, 1:(cats[(cvar[indx])[i]])] <- -as.integer(cdir[i])
## newc[i, 1:ccut[i]] <- as.integer(cdir[i])
## }
## catmat <- if (ncat == 0)
## newc
## else {
## cs <- rpfit$csplit
## ncs <- ncol(cs)
## ncc <- ncol(newc)
## if (ncs < ncc)
## cs <- cbind(cs, matrix(0, nrow(cs), ncc - ncs))
## rbind(cs, newc)
## }
## ncat <- ncat + nadd
## }
## else catmat <- rpfit$csplit
## if (nsplit == 0) {
## frame <- data.frame(row.names = 1, var = "<leaf>", n = rpfit$inode[,
## 5], wt = rpfit$dnode[, 3], dev = rpfit$dnode[, 1],
## yval = rpfit$dnode[, 4], complexity = rpfit$dnode[,
## 2], ncompete = 0, nsurrogate = 0)
## }
## else {
## temp <- ifelse(index == 0, 1, index)
## svar <- ifelse(index == 0, 0, rpfit$isplit[temp, 1])
## frame <- data.frame(row.names = rpfit$inode[, 1], var = tname[svar +
## 1], n = rpfit$inode[, 5], wt = rpfit$dnode[, 3],
## dev = rpfit$dnode[, 1], yval = rpfit$dnode[, 4],
## complexity = rpfit$dnode[, 2], ncompete = pmax(0,
## rpfit$inode[, 3] - 1), nsurrogate = rpfit$inode[,
## 4])
## }
## if (method.int == 3) {
## numclass <- init$numresp - 2
## nodeprob <- rpfit$dnode[, numclass + 5]/sum(wt)
## temp <- pmax(1, init$counts)
## temp <- rpfit$dnode[, 4 + (1:numclass)] %*% diag(init$parms$prior/temp)
## yprob <- temp/rowSums(temp)
## yval2 <- matrix(rpfit$dnode[, 4 + (0:numclass)], ncol = numclass +
## 1)
## frame$yval2 <- cbind(yval2, yprob, nodeprob)
## }
## else if (init$numresp > 1)
## frame$yval2 <- rpfit$dnode[, -(1:3), drop = FALSE]
## if (is.null(init$summary))
## stop("Initialization routine is missing the 'summary' function")
## functions <- if (is.null(init$print))
## list(summary = init$summary)
## else list(summary = init$summary, print = init$print)
## if (!is.null(init$text))
## functions <- c(functions, list(text = init$text))
## if (method == "user")
## functions <- c(functions, mlist)
## where <- rpfit$which
## names(where) <- row.names(m)
## ans <- list(frame = frame, where = where, call = Call, terms = Terms,
## cptable = t(rpfit$cptable), method = method, parms = init$parms,
## control = controls, functions = functions, numresp = init$numresp)
## if (nsplit)
## ans$splits = splits
## if (ncat > 0)
## ans$csplit <- catmat + 2
## if (nsplit)
## ans$variable.importance <- importance(ans)
## if (model) {
## ans$model <- m
## if (missing(y))
## y <- FALSE
## }
## if (y)
## ans$y <- Y
## if (x) {
## ans$x <- X
## ans$wt <- wt
## }
## ans$ordered <- isord
## if (!is.null(attr(m, "na.action")))
## ans$na.action <- attr(m, "na.action")
## if (!is.null(xlevels))
## attr(ans, "xlevels") <- xlevels
## if (method == "class")
## attr(ans, "ylevels") <- init$ylevels
## class(ans) <- "rpart"